home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Docking / DockedControls11U.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-19  |  4.5 KB  |  157 lines
  1. unit DockedControls11U;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ActnList, Menus, ImgList, ComCtrls, ExtCtrls, ToolWin, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ImageList1: TImageList;
  12.     Label1: TLabel;
  13.     MainMenu1: TMainMenu;
  14.     ActionList1: TActionList;
  15.     actToggleToolbar: TAction;
  16.     Environment1: TMenuItem;
  17.     Toolbarvisible1: TMenuItem;
  18.     btnToggleFloat: TButton;
  19.     ControlBar1: TControlBar;
  20.     PageControl1: TPageControl;
  21.     TabSheet1: TTabSheet;
  22.     Label2: TLabel;
  23.     Image1: TImage;
  24.     ToolBar1: TToolBar;
  25.     ToolButton6: TToolButton;
  26.     ToolButton7: TToolButton;
  27.     ToolButton8: TToolButton;
  28.     ToolButton9: TToolButton;
  29.     ToolButton10: TToolButton;
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure actToggleToolbarExecute(Sender: TObject);
  32.     procedure actToggleToolbarUpdate(Sender: TObject);
  33.     procedure btnToggleFloatClick(Sender: TObject);
  34.     procedure PageControl1DockDrop(Sender: TObject;
  35.       Source: TDragDockObject; X, Y: Integer);
  36.     procedure PageControl1GetSiteInfo(Sender: TObject;
  37.       DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  38.       var CanDock: Boolean);
  39.     procedure ControlBar1GetSiteInfo(Sender: TObject; DockClient: TControl;
  40.       var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
  41.     procedure ControlBar1DockDrop(Sender: TObject;
  42.       Source: TDragDockObject; X, Y: Integer);
  43.     procedure ControlBar1UnDock(Sender: TObject; Client: TControl;
  44.       NewTarget: TWinControl; var Allow: Boolean);
  45.     procedure ToolBar1StartDock(Sender: TObject;
  46.       var DragObject: TDragDockObject);
  47.     procedure ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
  48.   private
  49.     CustomDockObject: TDragDockObject;
  50.   end;
  51.  
  52.   TToolBarDockForm = class(TToolDockForm)
  53.   protected
  54.     procedure WMClose(var Message: TWMClose);
  55.       message WM_CLOSE;
  56.   end;
  57.  
  58. var
  59.   Form1: TForm1;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. { TDockToolBarDockForm }
  66.  
  67. procedure TToolBarDockForm.WMClose(var Message: TWMClose);
  68. begin
  69.   //When form is closed, dock control back in old dock site
  70.   if (DockClientCount = 1) and (DockClients[0] is TToolBar) then
  71.     TToolBar(DockClients[0]).ManualDock(Form1.ControlBar1);
  72.   inherited
  73. end;
  74.  
  75. { TForm1 }
  76.  
  77. procedure TForm1.FormCreate(Sender: TObject);
  78. begin
  79.   Mouse.DragImmediate := False;
  80.   Image1.ManualDock(PageControl1);
  81.   ToolBar1.ManualDock(ControlBar1);
  82.   ToolBar1.FloatingDockSiteClass := TToolBarDockForm;
  83. end;
  84.  
  85. procedure TForm1.actToggleToolbarExecute(Sender: TObject);
  86. begin
  87.   ToolBar1.Visible := not (Sender as TAction).Checked
  88. end;
  89.  
  90. procedure TForm1.actToggleToolbarUpdate(Sender: TObject);
  91. begin
  92.   (Sender as TAction).Checked := ToolBar1.Visible
  93. end;
  94.  
  95. procedure TForm1.btnToggleFloatClick(Sender: TObject);
  96. begin
  97.   if ToolBar1.Floating then
  98.     ToolBar1.ManualDock(ControlBar1)
  99.   else
  100.     //ToolBar1.ManualDock(nil)
  101.     ToolBar1.ManualFloat(
  102.       Rect(Left, Top, Left + ToolBar1.UndockWidth, Top + ToolBar1.UndockHeight))
  103. end;
  104.  
  105. procedure TForm1.PageControl1DockDrop(Sender: TObject;
  106.   Source: TDragDockObject; X, Y: Integer);
  107. begin
  108.   if Source.Control = Image1 then
  109.     PageControl1.ActivePage.Caption := 'Athena'
  110. end;
  111.  
  112. procedure TForm1.PageControl1GetSiteInfo(Sender: TObject;
  113.   DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  114.   var CanDock: Boolean);
  115. begin
  116.   CanDock := not (DockClient is TToolBar)
  117. end;
  118.  
  119. procedure TForm1.ControlBar1GetSiteInfo(Sender: TObject; DockClient: TControl;
  120.   var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
  121. begin
  122.   //Only accept toolbars
  123.   CanDock := DockClient is TToolBar
  124. end;
  125.  
  126. procedure TForm1.ControlBar1DockDrop(Sender: TObject;
  127.   Source: TDragDockObject; X, Y: Integer);
  128. begin
  129.   with (Sender as TControlBar) do
  130.     BevelEdges := [beLeft, beRight, beTop, beBottom]
  131. end;
  132.  
  133. procedure TForm1.ControlBar1UnDock(Sender: TObject; Client: TControl;
  134.   NewTarget: TWinControl; var Allow: Boolean);
  135. begin
  136.   with (Sender as TControlBar) do
  137.     //When last control is being undocked,
  138.     //remove bevelled edges
  139.     if ControlCount = 1 then
  140.       BevelEdges := []
  141. end;
  142.  
  143. procedure TForm1.ToolBar1StartDock(Sender: TObject;
  144.   var DragObject: TDragDockObject);
  145. begin
  146.   DragObject := TToolDockObject.Create(ToolBar1);
  147.   CustomDockObject := DragObject
  148. end;
  149.  
  150. procedure TForm1.ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
  151. begin
  152.   CustomDockObject.Free;
  153.   CustomDockObject := nil
  154. end;
  155.  
  156. end.
  157.